#lang racket


(require "../base/main.rkt")
(require "../geometry/main.rkt")

(require "constructor-defer.rkt")

(provide
 ; primitives
 arc-cs
 arc-cs-p
 
 bbox-shape
 
 box-center
 box-n
 box-p
 box-pp
 
 circle-n
 
 pipe
 pipe-center
 
 ; operations
 move-x
 move-y
 move-z
 move-xy
 move-yz
 move-xz
  
 scale-x
 scale-y
 scale-z
 
 mirror-x
 mirror-y
 mirror-z)

; constructors

(define (arc-cs chord sagitta)
  (let* ((radius (arc-radius chord sagitta))
         (angle (arc-angle radius sagitta)))
    (arc angle radius)))

(define (arc-cs-p chord sagitta p)
  (move p (arc-cs chord sagitta)))


(define (bbox-shape bb)
  (box-pp
   (bbox-corner bb bbox-x-neg bbox-y-neg bbox-z-neg)
   (bbox-corner bb bbox-x-pos bbox-y-pos bbox-z-pos)))


(define (box-center width length height center)
  (let ((box (box width length height)))
    (case center
      ('center box)
      ('bottom (move (mult-c uz (/2 height)) box))
      ('top (move (mult-c uz (- (/2 height))) box))
      (else
       (error 'box-center (format "Unhandled value for center, given ~A" center))))))

(define (box-n width length height normal (center 'center))
  (rotate
   (p<\p uz normal)
   (cross-c uz normal)
   (box-center width length height center)))

(define (box-p p width length height)
  (move p (box width length height)))

(define (box-pp c1 c2)
  (let ((axis (sub-c c1 c2))
        (midc (midcoord c1 c2)))
    (let ((width (abs (xyz-x axis)))
          (length (abs (xyz-y axis)))
          (height (abs (xyz-z axis))))
      (box-p midc width length height))))


(define (circle-n radius normal-p)
  (rotate uz normal-p (circle radius)))

;(define (circle-p-n radius center-p normal-p)
;  (move-and-rotate-normal
;   center-p
;   normal-p
;   (circle radius)))


(define (pipe inner-radius outer-radius height)
  (subtract
   (cylinder outer-radius height)
   (cylinder inner-radius height)))

(define (pipe-center inner-radius outer-radius height center)
  (case center
    ('center
     (move-z (- (/2 height)) (pipe inner-radius outer-radius height)))
    ('bottom
     (pipe inner-radius outer-radius height))
    (else
     (error 'pipe-center (format "Unhandled value for center, given ~A" center)))))


; operations

(define (move-p p n shape)
  (move (mult-c p n) shape))

(define (move-p2 p1 p2 n1 n2 shape)
  (move (add-c (mult-c p1 n1) (mult-c p2 n2)) shape))

(define move-x (cλ move-p ux))
(define move-y (cλ move-p uy))
(define move-z (cλ move-p uz))
(define move-xy (cλ move-p2 ux uy))
(define move-yz (cλ move-p2 uy uz))
(define move-xz (cλ move-p2 ux uz))


(define (scale-x x shape)
  (scale (xyz x 1 1) shape))

(define (scale-y y shape)
  (scale (xyz 1 y 1) shape))

(define (scale-z z shape)
  (scale (xyz 1 1 z) shape))


(define (mirror-x shape)
  (scale-x -1 shape))

(define (mirror-y shape)
  (scale-y -1 shape))

(define (mirror-z shape)
  (scale-z -1 shape))